home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / language / xlispst.cpt / XLisp-Stat ƒ / Disk 1 / Examples / tour.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1990-06-09  |  1.2 KB  |  33 lines
  1. (provide "tour")
  2.  
  3. (defun sphere-rand (n)
  4.   (loop (let* ((x (- (* 2 (uniform-rand n)) 1))
  5.                (nx2 (sum (^ x 2))))
  6.           (if (< nx2 1) (return (/ x (sqrt nx2)))))))
  7.  
  8.  
  9. (defun tour-plot (&rest args)
  10.   (let ((p (apply #'spin-plot args)))
  11.     (send p :add-slot 'tour-count -1)
  12.     (send p :add-slot 'tour-trans nil)
  13.     (defmeth p :do-idle () (send self :tour-step))
  14.     (defmeth p :tour-step ()
  15.       (when (< (slot-value 'tour-count) 0)
  16.             (let ((vars (send self :num-variables))
  17.                   (angle (abs (send self :angle))))
  18.               (setf (slot-value 'tour-count) 
  19.                     (random (floor (/ pi (* 2 angle)))))
  20.               (setf (slot-value 'tour-trans) 
  21.                     (make-rotation (sphere-rand vars) 
  22.                                    (sphere-rand vars)
  23.                                    angle))))
  24.       (send self :apply-transformation (slot-value 'tour-trans))
  25.       (setf (slot-value 'tour-count) (- (slot-value 'tour-count) 1)))
  26.     (defmeth p :tour-on (&rest args) (apply #'send self :idle-on args))
  27.     (let ((item (send graph-item-proto :new "Touring" p
  28.                       :tour-on :tour-on :toggle t)))
  29.       (send item :key #\T)
  30.       (send (send p :menu) :append-items item))
  31.     p))
  32.     
  33.